home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / stat.zip / MATH.PAS < prev    next >
Pascal/Delphi Source File  |  1990-08-05  |  10KB  |  404 lines
  1. {--------------------------------------------------------------------------}
  2. {                         Norton Mathematical Library                      }
  3. {                                                                          }
  4. {                              Version   1.00                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {                    Copyright 1990 Norton Associcates                     }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:   Math             }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {$S-,R-,V-,D-,A+,B+,N+,E-,I-}
  18.  
  19. UNIT
  20.     math;
  21.  
  22. INTERFACE
  23.  
  24. CONST
  25.      PI       = 3.14159265359;
  26.      pi_2     = PI / 2.0;
  27.      pi2      = PI * 2.0;
  28.      rad      = 180.0 / PI;
  29.      i_rad    = PI / 180.0;
  30.      one      = 1.00;
  31.      zero     = 0.00;
  32.      infinity = 1.0e09;
  33.      i_ln10     : DOUBLE =  1.0/2.302585093;
  34.  
  35. FUNCTION deg_rad( x : SINGLE) : SINGLE;
  36. FUNCTION rad_deg( x : SINGLE) : SINGLE;
  37.  
  38. FUNCTION arcsin( x : SINGLE) : SINGLE;
  39. FUNCTION arccos( x : SINGLE) : SINGLE;
  40. FUNCTION arctan2( x , y : SINGLE) : SINGLE;
  41.  
  42. FUNCTION tan( x : SINGLE) : SINGLE;
  43. FUNCTION secant( x : SINGLE) : SINGLE;
  44. FUNCTION cosecant( x : SINGLE) : SINGLE;
  45. FUNCTION cotan( x : SINGLE) : SINGLE;
  46.  
  47. FUNCTION factorial( number : WORD) : SINGLE;
  48.  
  49. FUNCTION power( x , y : EXTENDED) : EXTENDED;
  50. FUNCTION log10( x : SINGLE) : SINGLE;
  51. FUNCTION logxy( x , y : SINGLE) : SINGLE;
  52. FUNCTION dprod( x , y : EXTENDED) : EXTENDED;
  53. FUNCTION dble( x : EXTENDED) : EXTENDED;
  54. PROCEDURE secantmethod(VAR xn,xn_1,fxn,fxn_1 : EXTENDED);
  55.  
  56. FUNCTION sinh( x : EXTENDED) : SINGLE;
  57. FUNCTION cosh( x : EXTENDED) : SINGLE;
  58. FUNCTION tanh( x : EXTENDED) : SINGLE;
  59.  
  60. {*****************************************************************************}
  61. {*****************************************************************************}
  62. IMPLEMENTATION
  63. {*****************************************************************************}
  64. {*****************************************************************************}
  65.  
  66. FUNCTION deg_rad( x : SINGLE) : SINGLE;
  67. { Author : Norton Associates
  68.   Purpose: Convert from degrees to radians
  69.   Version: 1.0
  70.   Date   : 5 May 1990 }
  71.  
  72. BEGIN
  73.      deg_rad := x * i_rad;
  74. END;
  75.  
  76. FUNCTION rad_deg( x : SINGLE) : SINGLE;
  77. { Author : Norton Associates
  78.   Purpose: Convert from radians to degrees
  79.   Version: 1.0
  80.   Date   : 5 May 1990 }
  81. BEGIN
  82.      rad_deg := x * rad;
  83. END;
  84.  
  85. FUNCTION arcsin( x : SINGLE) : SINGLE;
  86. { Author : Norton Associates
  87.   Purpose: Calculate the arc sin
  88.   Version: 1.0
  89.   Date   : 5 May 1990 }
  90. VAR
  91.    dummy : SINGLE;
  92. BEGIN
  93.  
  94. { see if x is in range }
  95.      IF ABS(x) > one THEN
  96.      BEGIN
  97.           WRITELN('arcsin> input parameter out of range ',x:10:3);
  98.           HALT;
  99.      END;
  100.      dummy := SQRT(one - x * x);
  101.      IF dummy = zero THEN
  102.      BEGIN
  103.         IF x > zero THEN
  104.            arcsin := pi_2
  105.         ELSE
  106.            arcsin := -pi_2;
  107.      END
  108.      ELSE
  109.         arcsin := ARCTAN( x / dummy);
  110. END;
  111.  
  112. FUNCTION arccos( x : SINGLE) : SINGLE;
  113. { Author : Norton Associates
  114.   Purpose: Calculate the arc cosine
  115.   Version: 1.0
  116.   Date   : 5 May 1990 }
  117.  
  118. BEGIN
  119.  
  120. { check to see if x is in range }
  121.      IF ABS(x) > one THEN
  122.      BEGIN
  123.           WRITELN('arccos> input parameter out of range ',x:10:3);
  124.           HALT;
  125.      END;
  126.      IF x = zero THEN arccos := pi_2
  127.      ELSE IF x > zero THEN arccos := ARCTAN(SQRT(one - x * x ) / x)
  128.                       ELSE arccos := PI + ARCTAN(SQRT(one - x * x ) / x);
  129. END;
  130.  
  131. FUNCTION factorial( number : WORD) : SINGLE;
  132. { Author : Norton Associates
  133.   Purpose: Calculate factorial
  134.   Version: 1.0
  135.   Date   : 5 May 1990 }
  136.  
  137. VAR
  138.    fact : DOUBLE;
  139.    i    : WORD;
  140.  
  141. BEGIN
  142.     fact := one;
  143.     FOR i := 2 TO number DO
  144.         fact := fact * i;
  145.     factorial := fact;
  146. END;
  147.  
  148. FUNCTION tan( x : SINGLE) : SINGLE;
  149. { Author : Norton Associates
  150.   Purpose: Calculate tangent
  151.   Version: 1.0
  152.   Date   : 5 May 1990 }
  153.  
  154. VAR
  155.    dumcos,dumsin : SINGLE;
  156.  
  157. BEGIN
  158.      dumcos := COS(x);
  159.      dumsin := SIN(x);
  160.      IF dumcos = zero THEN
  161.      BEGIN
  162.          IF dumsin > zero THEN
  163.             tan := infinity
  164.          ELSE
  165.          BEGIN
  166.             IF dumsin = zero THEN
  167.                tan := zero
  168.             ELSE
  169.                tan := -infinity;
  170.          END;
  171.      END
  172.      ELSE
  173.          tan := dumsin / dumcos;
  174. END;
  175.  
  176. FUNCTION arctan2( x , y : SINGLE) : SINGLE;
  177. { Author : Norton Associates
  178.   Purpose: Calculate arc tangent : all four quadrants
  179.   Version: 1.0
  180.   Date   : 5 May 1990 }
  181.  
  182. VAR
  183.    angle : SINGLE;
  184.  
  185. BEGIN
  186.  
  187. { make sure x and y are in range }
  188.      IF (x <> zero) AND (y <> zero) THEN
  189.      BEGIN
  190.         angle := ARCTAN(ABS(y/x));
  191.         IF x > zero THEN
  192.         BEGIN
  193.           IF y > zero THEN arctan2 := angle
  194.                       ELSE arctan2 := pi2 - angle;
  195.         END
  196.         ELSE
  197.         BEGIN
  198.           IF y > zero THEN arctan2 := PI - angle
  199.                       ELSE arctan2 := PI + angle;
  200.         END;
  201.      END
  202.      ELSE
  203.      BEGIN
  204.         IF (x = zero) AND (y = zero) THEN
  205.         BEGIN
  206.             WRITELN('arctan2> x and y values = 0.0');
  207.             HALT;
  208.         END
  209.         ELSE
  210.         BEGIN
  211.             IF x = zero THEN
  212.             BEGIN
  213.                IF y > zero THEN arctan2 := pi_2
  214.                            ELSE arctan2 := 3.0 * pi_2;
  215.             END
  216.             ELSE
  217.             BEGIN
  218.                IF x >= zero THEN arctan2 := zero
  219.                             ELSE arctan2 := PI;
  220.             END;
  221.         END;
  222.      END;
  223. END;
  224.  
  225. FUNCTION secant( x : SINGLE) : SINGLE;
  226. { Author : Norton Associates
  227.   Purpose: Calculate secant of x
  228.   Version: 1.0
  229.   Date   : 5 May 1990 }
  230.  
  231. VAR
  232.    test : SINGLE;
  233.  
  234. BEGIN
  235.      test := COS(x);
  236.      IF test = zero THEN
  237.      BEGIN
  238.         WRITELN('secant> can not divide by zero ', x:10:5);
  239.         HALT;
  240.      END
  241.      ELSE
  242.         secant := 1.0 / test;
  243. END;
  244.  
  245. FUNCTION cosecant( x : SINGLE) : SINGLE;
  246. { Author : Norton Associates
  247.   Purpose: Calculate cosecant of x
  248.   Version: 1.0
  249.   Date   : 5 May 1990 }
  250.  
  251. VAR
  252.    test : SINGLE;
  253.  
  254. BEGIN
  255.      test := SIN(x);
  256.      IF test = zero THEN
  257.      BEGIN
  258.         WRITELN('cosecant> can not divide by zero ',x:10:5);
  259.         HALT;
  260.      END
  261.      ELSE
  262.         cosecant := 1.0 / test;
  263. END;
  264.  
  265. FUNCTION cotan( x : SINGLE) : SINGLE;
  266. { Author : Norton Associates
  267.   Purpose: Calculate costangent of x
  268.   Version: 1.0
  269.   Date   : 5 May 1990 }
  270.  
  271. VAR
  272.    test : SINGLE;
  273.  
  274. BEGIN
  275.      test := tan(x);
  276.      IF test = zero THEN
  277.      BEGIN
  278.         WRITELN('cotangent> can not divide by zero ',x:10:5);
  279.         HALT;
  280.      END
  281.      ELSE
  282.         cotan := 1.0 / test;
  283. END;
  284.  
  285. FUNCTION power( x , y : EXTENDED) : EXTENDED;
  286. { Author : Norton Associates
  287.   Purpose: Raise x to y
  288.   Version: 1.0
  289.   Date   : 5 May 1990 }
  290.  
  291. BEGIN
  292.      IF  x > zero  THEN
  293.         power := EXP( LN(x ) * y)
  294.      ELSE IF x = zero THEN
  295.              power := zero
  296.           ELSE
  297.               power := -one;
  298. END;
  299.  
  300. FUNCTION log10( x : SINGLE) : SINGLE;
  301. { Author : Norton Associates
  302.   Purpose: Find logarithm base 10 of x
  303.   Version: 1.0
  304.   Date   : 5 May 1990 }
  305.  
  306. BEGIN
  307.      log10 := LN(x)* i_ln10;
  308. END;
  309.  
  310. FUNCTION logxy( x , y : SINGLE) : SINGLE;
  311. { Author : Norton Associates
  312.   Purpose: Find logarithm base y of x
  313.   Version: 1.0
  314.   Date   : 5 May 1990 }
  315.  
  316. VAR
  317.    test : SINGLE;
  318.  
  319. BEGIN
  320.      test := LN(y);
  321.      IF test = zero THEN
  322.      BEGIN
  323.          WRITELN('logxy> can not divide by zero ',y:10:5);
  324.          HALT;
  325.      END
  326.      ELSE
  327.          logxy := LN(x)/test;
  328. END;
  329.  
  330. FUNCTION dprod( x , y : EXTENDED) : EXTENDED;
  331. { Author : Norton Associates
  332.   Purpose: Find double precision of two values
  333.   Version: 1.0
  334.   Date   : 5 May 1990 }
  335.  
  336. BEGIN
  337.      dprod := x * y;
  338. END;
  339.  
  340. FUNCTION dble( x : EXTENDED) : EXTENDED;
  341. { Author : Norton Associates
  342.   Purpose: Find double precision of a value
  343.   Version: 1.0
  344.   Date   : 5 May 1990 }
  345.  
  346. BEGIN
  347.       dble := x;
  348. END;
  349.  
  350. PROCEDURE secantmethod( VAR xn, xn_1, fxn, fxn_1 : EXTENDED);
  351. { Author : Norton Associates
  352.   Purpose: Find root of equation based upon secant method
  353.   Version: 1.0
  354.   Date   : 5 May 1990 }
  355.  
  356. VAR
  357.    newvar : EXTENDED;
  358.  
  359. BEGIN
  360.  
  361.      newvar := xn - ( (fxn * ( xn - xn_1 ))/( fxn - fxn_1 ) );
  362.      xn_1   := xn;
  363.      fxn_1  := fxn;
  364.      xn     := newvar;
  365. END;
  366.  
  367. FUNCTION sinh( x : EXTENDED) : SINGLE;
  368. { Author : Norton Associates
  369.   Purpose: Determine hyperbolic sine of x
  370.   Version: 1.0
  371.   Date   : 5 May 1990 }
  372.  
  373. BEGIN
  374.      sinh := (EXP(x) - EXP(-x) ) * 0.5;
  375. END;
  376.  
  377. FUNCTION cosh( x : EXTENDED) : SINGLE;
  378. { Author : Norton Associates
  379.   Purpose: Determine hyperbolic cosine of x
  380.   Version: 1.0
  381.   Date   : 5 May 1990 }
  382.  
  383. BEGIN
  384.      cosh := (EXP(x) + EXP(-x) ) * 0.5;
  385. END;
  386.  
  387. FUNCTION tanh( x : EXTENDED) : SINGLE;
  388. { Author : Norton Associates
  389.   Purpose: Determine hyperbolic tangent of x
  390.   Version: 1.0
  391.   Date   : 5 May 1990 }
  392.  
  393. VAR
  394.    a : EXTENDED;
  395.    b : EXTENDED;
  396. BEGIN
  397.      a := EXP(x);
  398.      b := EXP(-x);
  399.      tanh := (a - b)/(a + b);
  400. END;
  401. BEGIN
  402.  
  403. END.
  404.